COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C  MPRNT.F4********** DRAWS MUSIC ON THE PLOTTER OR XGP **********
C00018 ENDMK
C⊗;
C  MPRNT.F4********** DRAWS MUSIC ON THE PLOTTER OR XGP **********
C *** READS DATA FROM DSK FOR VARIOUS THINGS.

	COMMON /DL/IXRX,SAVER,NAME,EXT /FRMT/F78F(1),FA1(1),FA5(1),ASK
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
C					   ↓↓↓↓↓ V IS FOR READIN ONLY
C%%%%%%%%
	COMMON /STF/RSTFAC(0/7),RSTJ2  /POSI/STFF(0/7),JJ2,POS
	1 /PTR/PWDS(250),ITEM,L,I,M /DPY/GO,TOP,BOT /FONT/JFONT
	1/PLTR/PLT,RHT,DIS,XDIS
	COMMON /XRN/ RN(3000),V(1000) /ALF/INP(72),ML /SSS/SSS(200)
	1 /SLR/SLURX(272) 
C ORDER OF COMMON MUST! REMAIN AS IS (FOR DMP MODE READ)
	DATA DIS/1.24/
	CALL SEGFIX
C  TO ENABLE MULTIPLE USE OF UPPER SEGMENT (TVR)
	CALL MPRFAI
	END    

C***** SOME TYPEOUT AND ACCEPT ROUTINES *******

CC	SUBROUTINE WHY      
CC	END

	SUBROUTINE UNKNWN(JA)
	TYPE 5700,JA
5700	FORMAT(' UNKNOWN CODE=',I3)
C TRAP FOR UNKNOWN CODE #S (SUCH AS 99 - FOR "NO KSIG".
	END

	SUBROUTINE ENDIT(A,ITMS)
	COMMON /OUTF/JJ,KOUT
	TYPE 300,A,ITMS,KOUT
	CALL PLOT(0,0,99)
C  THE END OF THE DATA
300	FORMAT(F7.2,' INCHES',I,' ITEMS ',9X,A5,'.PLT')
C  THE END OF THE DATA
	END

	SUBROUTINE ILLEGL(JA)
	TYPE 160,JA
160	FORMAT(' ILLEGAL STAFF# ',I4)
	END

	SUBROUTINE TOOMCH(K)
	TYPE 4202,K
	STOP
4202	FORMAT(' ***** TOO MUCH DATA ',I4,'/2000')
	END

CCCCCCCCCCCCCCCCCCC  SUBRS.  SLUR, PLTSRT, (LINES, RDRAW),PLTCMD

	SUBROUTINE PLTCMD(NOSET)
	COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK /OUTF/JJ,KOUT
	DIMENSION NMS(15),RMOV1(15),RMOV2(15)
	COMMON /DL/RSIZ,SAVER,NAME,EXT /ALF/INP(72),ML
	COMMON R2,JE,CENTR,JB,RJQ(20),JQ(20)
	EQUIVALENCE (R5,RJQ(3)),(R6,RJQ(4)),(R7,RJQ(5)),(R4,RJQ(2))
	1,(R3,RJQ(1)),(I2,INP(2)),(R8,RJQ(6)),(R9,RJQ(7))
C  BE CAREFUL OF COMMON OVERLAPS WITH NOTWRT,ITMSUB,HOMER, ETC.
CC	F78F(1)='(78F)'
CC	FA5(1)='(A5) '
	DATA FA1(1)/'(A1) '/,F78F(1)/'(78F)'/,EXT/'DMD'/

	IF(I2.NE.'X')GO TO 1
	I2=0
C  I2=X FIRST TIME THROUGH
	RXC=0
	RMOV1(1)='Y'
	NAME=0
14	KA=0
3	KA=KA+1
	IF(MLL.EQ.0)GO TO 15
	K=K-2
	MLL=MLL-1
	IF(MLL.EQ.0)GO TO 10
	GO TO 31
15	TYPE 2,KA
CF	ACCEPT 11,K,MLL,RSPC
C  TYPE FIRST NAME, NUMBER  FOR A SERIES, 2ND NUM FOR FIXED SPACE ".
	CALL NAMEXT(K,EXT,MLL,RSPC)
CF	REREAD 351,JJ,R8 
	IF(K.NE.' ')GO TO 51
	IF(KA.NE.1)GO TO 10
C  DEFAULT NAME IS 'TMP    1'
	K='TMP'
	MLL=1
51	IF(K.EQ.'99')GO TO 140
C  99=BACKUP
	IF(JJ.NE.'EXT ')GO TO 251
C TYPE 'EXT XXX' TO READ FILES WITH EXTENSION .XXX
	EXT=R8
	GO TO 15
351	FORMAT(A4,A3)
251	IF(MLL.GE.99)GO TO 151
	IF(MLL.EQ.0)GO TO 151
	K=K+2*(MLL-1)
C THIS CHANGES GIVEN NAME TO LAST OF SERIES.
C I.E. AAAAA 5  WILL GET AAAAE FIRST AND WORK BACKWARDS.
151	IF(K.NE.'NOSET')GO TO 31
	NOSET=-1
C  ACTIVATES ANTI-RESET IN MPRFAI.FAI
	GO TO 15

31	IF(LOOKX(K,EXT))GO TO 56
C JUMP IF FILE FOUND
	TYPE 55
	GO TO 15
55	FORMAT(' FILE NOT FOUND'/)
11	FORMAT(A5,I,F)
56	IF(MLL.LT.99)GO TO 560
	MLL=0 
561	K=K+2
C  TYPE 'AAAAA 99'  TO FIND ALL IN 'AAAAx' SERIES AUTOMATICALLY
	MLL=MLL+1
	IF(LOOKX(K,EXT))GO TO 561
C  KEEPS GOING BACK IF FILES ARE FOUND
	K=K-2
560	NMS(KA)=K
	IF(MLL.EQ.0)GO TO 5
	R8='Y'
	IF(RSPC.NE.0)R8=RSPC
	GO TO 21
5	TYPE 8
	ACCEPT 11,R8
	IF(R8.EQ.'99')GO TO 15
	IF(R8.NE.'Y')R8=0
	IF(R8.EQ.0)REREAD F78F,R8
C  MOVE NUMBER CAN BE TYPED FOR 'MOVE UP'
21	RMOV1(KA+1)=R8
	RMOV2(KA)=R8
	GO TO 3
140	KA=KA-1
	GO TO 15

10	KB=KA-1
	IF(I3.NE.'G')GO TO 22
	RSIZ=1
	GO TO 222
22	TYPE 9
	ACCEPT F78F,RSIZ,R9
C  SET R9 TO 1 FOR HEAVY STAFF LINES (FOR XGP MAINLY)
	IF(RSIZ.EQ.99)GO TO 5
	IF(RSIZ.EQ.0)RSIZ=1.
	TYPE 550
	ACCEPT 11,JJ
	IF(JJ.EQ.' ')JJ='PLT'
	KOUT=JJ
550	FORMAT(' TYPE OUTPUT NAME - '$)
222	KA=0

1	IF(NAME.NE.0)GO TO 12
	IF(KA.NE.KB)GO TO 13
	I2=-1
	RETURN
C  THE END OF THE DATA
13	NAME=NMS(KA+1)
	TYPE 111,NAME,EXT
	RETURN
12	KA=KA+1
	NAME=0
	R8=0
	R2=RSIZ
	R3=RSIZ
C  FOR FILLER.  SIZES .LT. 1.6 = EVERY SCAN LINE, .LT. 2.6 = 2, ETC.
	R7=0
	R5=1
	R6=1
	IF(RMOV2(KA).NE.'Y')R7=RMOV2(KA)
	IF(RMOV1(KA).NE.0)R5=0
	IF(RMOV2(KA).NE.0)GO TO 77
	IF(R7.EQ.0)RETURN
77	R6=0
2	FORMAT(' TYPE FILE NAME',I2,1X$)
8	FORMAT(' MOVE UP AT END? ',$)
9	FORMAT(' SIZE FACTOR? ',$)
111	FORMAT(1XA5,'.',A3/)
	END


	SUBROUTINE SLUR
	IMPLICIT INTEGER(A-Q,T-Z)
	COMMON /ALF/INP,SLURY(72) /SSS/ SSS(200) /SLR/ SLURX(272) 
	REAL CENTR
	COMMON /PLTR/PLT,RHT,RDIS,XDIS
	COMMON R2,JA,CENTR,J2,R3,R4,R5,R6,R7,R8,R9,R10,RA,RB,
	1 K,KQ,TWICE,RST7,RX,RXX,RTILT,RC,RZ,RW,J3,J4,
	1 J5,J6,J7,J8,J9,J10,J11,JQ(7),R,RJ
	COMMON/PTR/PWDS(250),ITEM,L,I,IX /STF/RSTFAC(0/7),RSTJ2
CF	DATA RZZ/2.8/
C  DEFAULT VALUE OF SLUR CURVE FACTOR IS 2.8

CXX	IF(JA.NE.12)GO TO 2
CF	RA=5.96*RSJT2*R5
CF	L=3
CF	J8=J8*RDIS
CF	IF(J7.LE.J6)J7=J7+360
CF	KQ=6
CF	IF(PLT)KQ=1
CF10	DO 3 K=J6,J7,KQ
CF	R=K
CF	CALL LINES(R3+RA*SIND(R),CENTR+RA*COSD(R),L)
CF3	L=2
CF	J8=J8-1
CF	IF(J8)RETURN
CF	RA=RA+1/RDIS
CF	L=3
CF	GO TO 10
CJA=12  DRAWS CIRCLES. P5=RADIUS, P6=DEGR.1, P7=DEGR.2,P8=THICK(EXPANDS
CXX	CALL CIRCLE
CXX	RETURN

2	J10=1
	J4=0
	KQ=5 
	TWICE=-1
C  -1 FOR DISPLAY, USES ONLY 1/3 OF SEGMENTS
	IF(PLT.GE.0)GO TO 21
	TWICE=0
	KQ=1
	RWID=.2
	IF(RHT.LT.2)GO TO 21
	TWICE=1
	RWID=.14
C  IF SIZE IS GT.2 3 SLURS ARE DRAWN
	IF(RHT.LT.3)GO TO 21
	TWICE=2
C  IF SIZE IS GE.3 4 SLURS ARE DRAWN
	RWID=.1
21	RST7=RSTJ2*7.
	RQQ=R5-R4
	IF(R6.GT.1000)CALL RNOTE(R6)
	GO TO (5,6,7),J8+4
	GO TO 4
5	R=30
CC5	R=32
C AFTER DOTTED NOTE
	GO TO 8
6	R=18
CC6	R=22
C BETWEEN NOTES
8	RX=-0.75
CC8	RX=-1.3
	GO TO 9
7	R=7
	RX=RSTJ2
9	CALL RJBX(R)
	R6=R6+RX
4	RXX=RHORZ(R6)-R3
	RTILT=RQQ*RST7
80	RX=SQRT(RXX*RXX+RTILT*RTILT)
	IF(J8.NE.-1)GO TO 10
	IF(RQQ.GT.8)RQQ=8
	IF(RQQ.LT.-8)RQQ=-8
	RQQ=RQQ*RSTFAC(J2)
	IF(R7)RQQ=-RQQ
	R3=R3-RQQ
C  MOVES STEEP SLUR LEFT OR RIGHT IF P8=-1
10	RJ=ABS(R7)
C R7+100=LEFT HALF SLUR, +200=RIGHT HALF, +300=REVERSE DIRECTION.
	IF(RJ.LT.100)RJ=-1
	IF(RJ.GE.300)RJ=0
	R7=AMOD(R7,100.0)
	L=RDIS*RX/5
	IF(L.LT.15)L=15
	IF(L.GT.68)L=68
	L=L*4
C  L=NUMB OF SEGMENTS IN THE CURVE.
1	R=CENTR
	IF(J8.GT.0)GO TO 180
C  JUMP FOR BRACKETS
	CALL SLOOP
CF	RB=RX/71.
CF	DO 81 K=0,71
CF81	SLURX(K+1)=RB*(K)+R3
CF	RA=R7*RST7
CF41	IF(R9.EQ.0)R9=RZZ
CF	R=R+RA
CF	L=0
CF	DO 40 K=36,1,-1
CF	L=L+1
CF	RW=R-RA*(K/36.)**R9
CF	SLURY(L)=RW
CF40	SLURY(73-L)=RW
CF	L=72

CF89	IF(RTILT.EQ.0)GO TO 87
CF	RW=ATAN2(RTILT,RXX)
CF	RA=SIN(RW)
CF	RB=COS(RW)
CF	RZ=SLURX(1)
CF	RW=SLURY(1)
CF	DO 83 K=1,L
CF	R=SLURX(K)-RZ
CF	RXX=SLURY(K)-RW
CF	SLURX(K)=RB*R-RA*RXX+RZ
CF83	SLURY(K)=RB*RXX+RA*R+RW

	IF(J4.NE.0)GO TO 83
87	CALL LINES(SLURX(J10),SLURY(J10),3)
	J4=-1
83	J5=KQ
	J6=J10
	J7=L
	IF(J4)GO TO 22
	J6=L
	J7=J10
	J5=-1
22	DO 88 K=J6,J7,J5
88	CALL LINES(SLURX(K),SLURY(K),2)
	IF(TWICE)RETURN
	TWICE=TWICE-1
	IF(J8.GT.0)GO TO 182
	J4=-J4
	R7=R7+RWID
C  RWID=WIDTH OF SLUR -- SEE DATA
	GO TO 1
180	RW=R+R7*RST7
	TWICE=-1
	KQ=1
	RX=RX+R3
CC	RA=(R5-R4)*RST7
	IF(J9.EQ.0)GO TO 181
	TWICE=2
	RZ=RTILT/(RX-R3)
	RXX=RX
	RWID=(R3+RXX)/2.
182	IF(TWICE.EQ.1)GO TO 183
C  DOES LEFT SIDE FIRST.
	IF(TWICE.EQ.0)GO TO 184
C LAST IS NUMBER.
	J8=2
	RC=RSTJ2*13.
	RX=RWID-RC
	RWW=RTILT
185	RTILT=RZ*(RX-R3)

C  PUT IN FUNC. HERE FOR THIS SLOPE AND FOR PART. BEAMS.

	GO TO 181
183	J8=3
	RX=RXX
	RTILT=RWW
	RXX=R3
	R3=RWID+RC
	RXX=RZ*(R3-RXX)
	R=R+RXX
	RW=RW+RXX
	GO TO 185

181	SLURX(1)=R3
	SLURY(1)=R
	SLURX(2)=R3
	SLURY(2)=RW
	SLURX(3)=RX
	SLURY(3)=RW+RTILT
	SLURX(4)=RX
	SLURY(4)=R+RTILT
	L=4
	IF(J8.EQ.2)L=3
	IF(J8.EQ.3)J10=2
CC	TWICE=-1
	GO TO 87
184	J3=RWID
C  PUT IN VERT. POS. WHEN SLOPE!
	R4=RQQ/2.+R4+R7-1.
	R6=1.
	R7=1.
	R8=0
	CALL MAKNUM(R9)
	END
C  8, POS1, STF, NT1, NT2, POS2, DIP(ABS. UNITS), P8
C        FOR P8: 0= SLUR, 1=BRACKETS, 2=LFT ONLY, 3=RT ONLY


CC	SUBROUTINE PLTSRT
C  SORTS DATA TO SHORTEN INVISIBLE VECTORS WHEN PLOTTING. 
CF	IMPLICIT INTEGER(S-Z)
CC	COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
CC	DIMENSION  P(250)
CC	CALL PSRT(P)
CC	END

CF	DO 4 K=1,ITEM
CF	L=PWDS(K)
CF	LL=PWDS(K-1)
CF	LM=PWDS(K+1)
CF	A=RN(L+3)
CF	P(K)=A+1000*RN(L+2)
CF	IF(RN(L+1).NE.16)GO TO 40
CF	Y=PWDS(K-1)
CF	V=PWDS(K+1)
CF	IF(RN(Y+1).EQ.16)GO TO 41
CF	IF(RN(V+1).EQ.16)GO TO 41
CF	GO TO 4
CF40	IF(A.GE.0)GO TO 4
CF41	P(K)=-10000
CF4	CONTINUE
C  PLOTS ALL NEG. POSITIONS FIRST.
CF	IX=I
CF	IF(I.LT.1500)I=1500
CF	Y=I
CF	I=I+IX-1
CF	IX=Y
C  IX IS M IN MAIN PROG.
C  LEAVES 1500 WDS IN RN FOR STORING "NOIR" DATA.
CF2	A=P(1)
CF	L=1
CF	DO 1 K=1,ITEM
CF	IF(A.LE.P(K))GO TO 1
CF	A=P(K)
CF	L=K
CF1	CONTINUE
CF	IF(A.EQ.10000.)RETURN
C  ALL ITEMS HAVE NOW BEEN SHUFFLED
CF	V=PWDS(L)
CF	P(L)=10000
CF	L=RN(V)+2+Y
CF	V=V-Y
CC	CALL LOOP(0,L,1,Y,V,RN)
CF	DO 3 K=Y,L
CF3	RN(K)=RN(K+V)
C  REPLACED SUBROUTINE LOOP
CF	Y=L+1
CF	GO TO 2
CF	END


CX	SUBROUTINE LINES(A,B,L)
CX	COMMON /FL/IC,NZ,NX,RZ,XGP
CX	COMMON/DL/IIII,SAVER,AA /PLTR/IPLT,RHT,DIS
CX	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) 
CX	COMMON/DPY/GO,TOP,BOT
CX	DATA BB/260.0/,CC/3.5/,DD/1.43/,MX/512/
C  SET XGP TO 1245.0 FOR MARGIN IN XEROX COPIES
CX22	GO TO 23
C  CHANGE ABOVE TO 'J6CL' IN DDT TO USE NEXT ITEMS.
CX24	AA=CC-DD*ABS(A)/BB
C  USE THIS IN DDT TO DISTORT ITEMS.  CC MUST BE > DD
CX	B=B*AA
CX23	IF(IPLT)GO TO 2
CX	IF(JA.EQ.44)RETURN
CC	K=B
CC	IF(K.GT.ITOP)ITOP=B
CC	IF(K.LT.IBOT)IBOT=B
CX	IF(B.GT.TOP)TOP=B
CX	IF(B.LT.BOT)BOT=B
CX6	RETURN
CC2	IF(IPLT.EQ.-2)RETURN
C RXGP SETS UP-DOWN POS. ON XEROX PAPER (FRACTIONAL POSITIONS POSSIBLE.)
CC	IF(IXRX.EQ.0)GO TO 9
CC	M=ROFF(RXGP-B*RHT)
CC	N=ROFF(XGP+A*DIS)
CC	GO TO 8
CX2	M=ROFF(A*DIS)
CX	N=ROFF(B*RHT)
CX8	CALL PLOT(M,N,L)
CX	END

	SUBROUTINE NAMEXT(NAME,EXT,NUM,SPC)
	COMMON /ALF/INP(72)
	DIMENSION FORM2(5),FORMT(5),NUMS(30)
	DATA FORMT(1)/'('/,FORM2/'A1,','A2,','A3,','A4,','A5,'/
	1, FORM3/'I,F)'/
	EQUIVALENCE (F1,FORMT(1)),(F2,FORMT(2)),(F3,FORMT(3)),
	1 (F4,FORMT(4)),(F5,FORMT(5))
1	FORMAT(72A1)
	ACCEPT 1,INP
	DO 2 K=2,72
	IF(INP(K).EQ.' ')GO TO 3
2	IF(INP(K).EQ.'.')GO TO 4
3	F3=FORM3
	F4=' '
	F5=' '
5	F2=FORM2(K-1)
	REREAD FORMT,NAME,NUM,SPC
	RETURN
4	FORMT(3)=FORM2(1)
C  CATCHES DOT
	DO 7 N=K+1,72
7	IF(INP(N).EQ.' ')GO TO 8
8	F4=FORM2(N-K-1)
	F5=FORM3
	F2=FORM2(K-1)
	REREAD FORMT,NAME,K,EXT,NUM,SPC
	END